home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ADA Programming Guide
/
ADA Programming Guide.iso
/
ada_gnu
/
adainc
/
s-signal.adb
< prev
next >
Wrap
Text File
|
1996-01-30
|
22KB
|
640 lines
------------------------------------------------------------------------------
-- --
-- GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . T A S K I N G . S I G N A L S --
-- B o d y --
-- --
-- $Revision: 1.11 $ --
-- --
-- Copyright (c) 1991,1992,1993,1994, FSU, All Rights Reserved --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU Library General Public License as published by the --
-- Free Software Foundation; either version 2, or (at your option) any --
-- later version. GNARL is distributed in the hope that it will be use- --
-- ful, but but WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Gen- --
-- eral Library Public License for more details. You should have received --
-- a copy of the GNU Library General Public License along with GNARL; see --
-- file COPYING.LIB. If not, write to the Free Software Foundation, 675 --
-- Mass Ave, Cambridge, MA 02139, USA. --
-- --
------------------------------------------------------------------------------
-- This package does not follow the GNARL/GNULL layering. It uses both GNARL
-- and GNULL packages without a clear layer in between.
with System.Error_Reporting;
with System.Storage_Elements;
with System.Task_Primitives; use System.Task_Primitives;
with System.Tasking.Utilities;
with System.Tasking.Rendezvous;
with Interfaces.C.POSIX_Error;
with Interfaces.C.Pthreads;
package body System.Signals is
package RTE renames Interfaces.c.POSIX_RTE;
package POSIX_Error renames Interfaces.C.POSIX_Error;
Failure : Interfaces.C.POSIX_Error.Return_Code
renames Interfaces.C.POSIX_Error.Failure;
Assertions_Checked : constant Boolean := True;
Max_Signal : constant := 32;
subtype Signal_Index is RTE.Signal range 1 .. Max_Signal - 1;
type Signal_Assoc is record
T : Tasking.Task_ID;
E : Tasking.Task_Entry_Index;
end record;
Null_Signal_Assoc : constant Signal_Assoc
:= Signal_Assoc' (T => Tasking.Null_Task, E => Tasking.Null_Task_Entry);
User_Handler_Table : array (Signal_Index) of Signal_Assoc
:= (others => Null_Signal_Assoc);
type Server_Info is record
Task_ID : Tasking.Task_ID; -- Indivisual signal handling task's Task_ID
Blocked : boolean; -- Process level Blocking Indication
Ignored : boolean; -- Process level Ignoring Indication
Asynchronous : boolean; -- Only Asynchronous signals can have
end record; -- user level handler
Signal_Server_Table : array (Signal_Index) of Server_Info
:= (RTE.SIGKILL | RTE.SIGSTOP | RTE.SIGALRM | RTE.SIGILL | RTE.SIGFPE |
RTE.SIGSEGV | RTE.SIGEMT | RTE.SIGBUS | RTE.SIGTRAP |
RTE.SIGABRT | RTE.SIGUSR1
-- These two signals are asynchronous signals according to POSIX
=> (Task_ID => Tasking.Null_Task,
Blocked => false,
Ignored => false,
Asynchronous => false),
others
=> (Task_ID => Tasking.Null_Task,
Blocked => false,
Ignored => false,
Asynchronous => true));
task type Handler_Task (S : RTE.Signal);
-- T : Handler_Task (RTE.SIGABRT);
-- SIGABRT should also be available for interrupt entry.
T1 : Handler_Task (RTE.SIGHUP);
T2 : Handler_Task (RTE.SIGINT);
T3 : Handler_Task (RTE.SIGPIPE);
T4 : Handler_Task (RTE.SIGQUIT);
T5 : Handler_Task (RTE.SIGTERM);
-- T : Handler_Task (RTE.SIGUSR1);
-- SIGUSR1 should also be available for interrupt entry.
T6 : Handler_Task (RTE.SIGUSR2);
T7 : Handler_Task (RTE.SIGCHLD);
T8 : Handler_Task (RTE.SIGCONT);
T9 : Handler_Task (RTE.SIGTSTP);
T10 : Handler_Task (RTE.SIGTTIN);
T11 : Handler_Task (RTE.SIGTTOU);
-- Additional asynchronous signals not required by POSIX
T12 : Handler_Task (RTE.SIGSYS);
T13 : Handler_Task (RTE.SIGURG);
T14 : Handler_Task (RTE.SIGIO);
T15 : Handler_Task (RTE.SIGXCPU);
T16 : Handler_Task (RTE.SIGXFSZ);
T17 : Handler_Task (RTE.SIGVTALRM);
T18 : Handler_Task (RTE.SIGPROF);
T19 : Handler_Task (RTE.SIGWINCH);
T20 : Handler_Task (RTE.SIGLOST);
task Signal_Manager is
entry Bind_Handler (T : Tasking.Task_ID;
E : Tasking.Task_Entry_Index;
S : RTE.Signal);
entry Unbind_Handler (T : Tasking.Task_ID);
entry Block_Signal (S : RTE.Signal);
entry Unblock_Signal (S : RTE.Signal);
end Signal_Manager;
M : array (Signal_Index) of Lock;
C : array (Signal_Index) of Condition_Variable;
procedure Assert (B : Boolean; M : String)
renames Error_Reporting.Assert;
function Address_To_Pointer is new
Unchecked_Conversion (System.Address, RTE.sigaction_ptr);
function Address_To_Signal (A : System.Address) return RTE.Signal;
function Address_To_Signal (A : System.Address) return RTE.Signal is
begin
return RTE.Signal (Storage_Elements.To_Integer (A));
end Address_To_Signal;
function Address_To_Pointer is new
Unchecked_Conversion (System.Address, RTE.sigset_t_ptr);
-- local procedures
-----------------------
-- Handler_Installed --
-----------------------
function Handler_Installed (S : RTE.Signal) return boolean;
----------------------
-- Server_Installed --
----------------------
function Server_Installed (S : RTE.Signal) return boolean;
-----------------
-- Signal_Task --
-----------------
procedure Signal_Task (T : Tasking.Task_ID; S : RTE.Signal);
-------------------------
-- Thread_Block_Signal --
-------------------------
procedure Thread_Block_Signal (S : RTE.Signal);
---------------------------
-- Thread_Unblock_Signal --
---------------------------
procedure Thread_Unblock_Signal (S : RTE.Signal);
-------------------------
-- Asynchronous_Signal --
-------------------------
function Asynchronous_Signal (S : RTE.Signal) return boolean;
-------------------------
-- Initialize_Blocking --
-------------------------
procedure Initialize_Blocking;
------------------------
-- Unmask_All_Signals --
------------------------
procedure Unmask_All_Signals;
----------------------------
-- Is_Blocked_Unprotected --
----------------------------
function Is_Blocked_Unprotected
(S : Interfaces.C.POSIX_RTE.Signal) return boolean;
----------------------------
-- Is_Ignored_Unprotected --
----------------------------
function Is_Ignored_Unprotected
(S : Interfaces.C.POSIX_RTE.Signal) return boolean;
-- end of local procedure declaratoins.
task body Signal_Manager is
Action : RTE.struct_sigaction;
Oact : RTE.struct_sigaction;
Result : Interfaces.C.POSIX_Error.Return_Code;
Ceiling_Violation : boolean;
begin
Unmask_All_Signals;
-- initially unmask Ref (boundable) signals for which we want
-- the default action
Initialize_Blocking;
-- update the Block_Table to reflect the process level blocked signals
loop
select
accept Bind_Handler (T : Tasking.Task_ID;
E : Tasking.Task_Entry_Index;
S : RTE.Signal) do
if not Asynchronous_Signal (S) then
raise Program_Error;
end if;
if Handler_Installed (S) then raise Program_Error; end if;
-- User should not try to redefine handler before explicitly
-- detaching it
Write_Lock (M (S), Ceiling_Violation);
User_Handler_Table (S) := Signal_Assoc' (T => T, E => E);
Cond_Signal (C (S));
-- we have installed a handler if the Handler Task is
-- waiting to be woke up, do it here.
if not Is_Blocked_Unprotected (S) then
Thread_Block_Signal (S);
end if;
-- This is the case where signal is not blocked and
-- handler is installed. We want the handler to catch
-- signal through sigwait. So mask the signal for this
-- task.
Unlock (M (S));
end Bind_Handler;
or accept Unbind_Handler (T : Tasking.Task_ID) do
for I in Signal_Index loop
Write_Lock (M (I), Ceiling_Violation);
if User_Handler_Table (I).T = T then
User_Handler_Table (I) := Null_Signal_Assoc;
RTE.sigaction (I, Address_To_Pointer (Null_Address),
Action, Result);
Assert (Result /= Failure, "GNULL failure---sigaction");
-- restore the default action in case sigwait ruined it
if Is_Ignored_Unprotected (I) then
Action.sa_handler :=
Storage_Elements.To_Address (RTE.SIG_IGN);
else
Action.sa_handler :=
Storage_Elements.To_Address (RTE.SIG_DFL);
end if;
RTE.sigaction (I, Action, Oact, Result);
Assert (Result /= Failure, "GNULL failure---sigaction");
if not Is_Blocked_Unprotected (I) then
-- this is the case where the handler is waiting for
-- sigwait. We have to wake this up and make it to
-- wait on condition variable. Also.
-- unmask the signal to allow the default action again
Signal_Task (Signal_Server_Table (I).Task_ID, I);
Thread_Unblock_Signal (I);
end if;
end if;
Unlock (M (I));
end loop;
end Unbind_Handler;
or accept Block_Signal (S : RTE.Signal) do
-- caller holds mutex M (S)
Thread_Block_Signal (S);
end Block_Signal;
or accept Unblock_Signal (S : RTE.Signal) do
-- caller holds mutex M (S)
Thread_Unblock_Signal (S);
end Unblock_Signal;
or terminate;
end select;
end loop;
end Signal_Manager;
task body Handler_Task is
Action : RTE.struct_sigaction;
Sigwait_Mask : RTE.Signal_Set;
Sigwait_Signal : RTE.Signal;
Result : Interfaces.C.POSIX_Error.Return_Code;
Ceiling_Violation : boolean;
begin
Tasking.Utilities.Make_Independent;
-- By making this task independent of master when process goes away
-- handler will be terminated gracefully.
Write_Lock (M (S), Ceiling_Violation);
Signal_Server_Table (S).Task_ID := Tasking.Self;
-- Register the ID of this task so that other can explicitly
-- send a signal to this task (thread) using pthread_kill
RTE.Signal_Delete_All (Sigwait_Mask);
RTE.Signal_Add (Sigwait_Mask, S);
loop
if Is_Blocked_Unprotected (S) or else not Handler_Installed (S) then
Cond_Wait (C (S), M (S));
-- This is the place where we have to take the
-- default action if the signal is not blocked and there is
-- no handler installed.
-- wait for Unblock or Bind operation
else -- wait for actual signal
Unlock (M (S));
Interfaces.C.Pthreads.sigwait
(Sigwait_Mask, Sigwait_Signal, Result);
Assert (Result /= Failure, "GNULLI failure---sigwait");
Write_Lock (M (S), Ceiling_Violation);
if not Is_Blocked_Unprotected (S) and then
Handler_Installed (S) and then
not Is_Ignored_Unprotected (S)
then
Unlock (M (S));
Tasking.Rendezvous.Call_Simple
(User_Handler_Table (S).T, User_Handler_Table (S).E,
System.Null_Address);
Write_Lock (M (S), Ceiling_Violation);
end if;
end if;
end loop;
Unlock (M (S));
end Handler_Task;
--------------------------
-- Bind_Signal_To_Entry --
--------------------------
procedure Bind_Signal_To_Entry (T : Tasking.Task_ID;
E : Tasking.Task_Entry_Index;
Sig : System.Address) is
S : RTE.Signal := Address_To_Signal (Sig);
begin
Signal_Manager.Bind_Handler (T, E, S);
end Bind_Signal_To_Entry;
--------------------
-- Detach_Handler --
--------------------
procedure Detach_Handler (T : Tasking.Task_ID) is
begin
Signal_Manager.Unbind_Handler (T);
end Detach_Handler;
------------------
-- Block_Signal --
------------------
procedure Block_Signal (S : RTE.Signal) is
Ceiling_Violation : boolean;
begin
Write_Lock (M (S), Ceiling_Violation);
if not Is_Blocked_Unprotected (S) then
Signal_Server_Table (S).Blocked := true;
if Handler_Installed (S) then
Signal_Task (Signal_Server_Table (S).Task_ID, S);
else
Signal_Manager.Block_Signal (S);
end if;
end if;
Unlock (M (S));
end Block_Signal;
---------------------
-- Unlock_Signal --
---------------------
procedure Unblock_Signal (S : RTE.Signal) is
Ceiling_Violation : boolean;
begin
Write_Lock (M (S), Ceiling_Violation);
if Is_Blocked_Unprotected (S) then
Signal_Server_Table (S).Blocked := false;
if Handler_Installed (S) then
Cond_Signal (C (S));
-- should make this to wait on sigwait instead cond variable
else
Signal_Manager.Unblock_Signal (S);
end if;
end if;
Unlock (M (S));
end Unblock_Signal;
----------------
-- Is_Blocked --
----------------
function Is_Blocked (S : Interfaces.C.POSIX_RTE.Signal) return boolean is
Tmp : boolean;
Ceiling_Violation : boolean;
begin
Write_Lock (M (S), Ceiling_Violation);
Tmp := Signal_Server_Table (S).Blocked;
Unlock (M (S));
return Tmp;
end Is_Blocked;
----------------
-- Is_Ignored --
----------------
function Is_Ignored (S : Interfaces.C.POSIX_RTE.Signal) return boolean is
Tmp : boolean;
Ceiling_Violation : boolean;
begin
Write_Lock (M (S), Ceiling_Violation);
Tmp := Signal_Server_Table (S).Ignored;
Unlock (M (S));
return Tmp;
end Is_Ignored;
-------------------
-- Ignore_Signal --
-------------------
procedure Ignore_Signal (S : RTE.Signal) is
Action : RTE.struct_sigaction;
Oact : RTE.struct_sigaction;
Result : Interfaces.C.POSIX_Error.Return_Code;
Ceiling_Violation : boolean;
begin
Write_Lock (M (S), Ceiling_Violation);
if not Is_Ignored_Unprotected (S) then
RTE.sigaction (S, Address_To_Pointer (Null_Address),
Action, Result);
Action.sa_handler := Storage_Elements.To_Address (RTE.SIG_IGN);
RTE.sigaction (S, Action, Oact, Result);
Assert (Result /= Failure, "GNULL failure---sigaction");
Signal_Server_Table (S).Ignored := true;
end if;
Unlock (M (S));
end Ignore_Signal;
---------------------
-- Unignore_Signal --
---------------------
procedure Unignore_Signal (S : RTE.Signal) is
Action : RTE.struct_sigaction;
Oact : RTE.struct_sigaction;
Result : Interfaces.C.POSIX_Error.Return_Code;
Ceiling_Violation : boolean;
begin
Write_Lock (M (S), Ceiling_Violation);
if Is_Ignored_Unprotected (S) then
RTE.sigaction (S, Address_To_Pointer (Null_Address),
Action, Result);
Action.sa_handler := Storage_Elements.To_Address (RTE.SIG_DFL);
RTE.sigaction (S, Action, Oact, Result);
Assert (Result /= Failure, "GNULL failure---sigaction");
Signal_Server_Table (S).Ignored := false;
end if;
Unlock (M (S));
end Unignore_Signal;
-----------------------
-- Handler_Installed --
-----------------------
function Handler_Installed (S : RTE.Signal) return boolean is
begin
return User_Handler_Table (S) /= Null_Signal_Assoc;
end Handler_Installed;
----------------------
-- Server_Installed --
----------------------
function Server_Installed (S : RTE.Signal) return boolean is
begin
return Signal_Server_Table (S).Task_ID /= Tasking.Null_Task;
end Server_Installed;
-------------------
-- Signal_Task --
-------------------
procedure Signal_Task (T : Tasking.Task_ID; S : RTE.Signal) is
T_Access : Task_Primitives.TCB_Ptr :=
Utilities.ID_To_ATCB (T).LL_TCB'Access;
Result : Interfaces.C.POSIX_Error.Return_Code;
begin
Interfaces.C.Pthreads.pthread_kill
(T_Access.Thread, S, Result);
Assert (Result /= Failure, "GNULLI failure---pthread_kill");
end Signal_Task;
-------------------------
-- Thread_Block_Signal --
-------------------------
procedure Thread_Block_Signal (S : RTE.Signal) is
Signal_Mask, Old_Set : RTE.Signal_Set;
Result : Interfaces.C.POSIX_Error.Return_Code;
begin
RTE.Signal_Delete_All (Signal_Mask);
RTE.Signal_Add (Signal_Mask, S);
RTE.sigprocmask (RTE.SIG_BLOCK, Signal_Mask, Old_Set, Result);
Assert (Result /= Failure, "GNULLI failure---sigprocmask");
end Thread_Block_Signal;
---------------------------
-- Thread_Unblock_Signal --
---------------------------
procedure Thread_Unblock_Signal (S : RTE.Signal) is
Signal_Mask, Old_Set : RTE.Signal_Set;
Result : Interfaces.C.POSIX_Error.Return_Code;
begin
RTE.Signal_Delete_All (Signal_Mask);
RTE.Signal_Add (Signal_Mask, S);
RTE.sigprocmask (RTE.SIG_UNBLOCK, Signal_Mask, Old_Set, Result);
Assert (Result /= Failure, "GNULLI failure---sigprocmask");
end Thread_Unblock_Signal;
-------------------------
-- Asynchronous_Signal --
-------------------------
function Asynchronous_Signal (S : RTE.Signal) return boolean is
begin
return Signal_Server_Table (S).Asynchronous;
end Asynchronous_Signal;
-------------------------
-- Initialize_Blocking --
-------------------------
procedure Initialize_Blocking is
Signal_Mask, Old_Set : RTE.Signal_Set;
Result : Interfaces.C.POSIX_Error.Return_Code;
begin
RTE.sigprocmask (RTE.SIG_BLOCK, Address_To_Pointer (System.Null_Address),
Signal_Mask, Result);
Assert (Result /= Failure, "GNULL failure---sigprocmask");
for I in Signal_Index loop
if RTE.Member_Of (Signal_Mask, I) then
Signal_Server_Table (I).Blocked := true;
end if;
end loop;
end Initialize_Blocking;
------------------------
-- Unmask_All_Signals --
------------------------
-- Unmask asynchronous signals for calling thread.
procedure Unmask_All_Signals is
Signal_Mask, Old_Set : RTE.Signal_Set;
Result : Interfaces.C.POSIX_Error.Return_Code;
begin
RTE.Signal_Delete_All (Signal_Mask);
-- RTE.Signal_Add (Signal_Mask, RTE.SIGABRT);
RTE.Signal_Add (Signal_Mask, RTE.SIGHUP);
RTE.Signal_Add (Signal_Mask, RTE.SIGINT);
RTE.Signal_Add (Signal_Mask, RTE.SIGPIPE);
RTE.Signal_Add (Signal_Mask, RTE.SIGQUIT);
RTE.Signal_Add (Signal_Mask, RTE.SIGTERM);
-- RTE.Signal_Add (Signal_Mask, RTE.SIGUSR1);
RTE.Signal_Add (Signal_Mask, RTE.SIGUSR2);
RTE.Signal_Add (Signal_Mask, RTE.SIGCHLD);
RTE.Signal_Add (Signal_Mask, RTE.SIGCONT);
RTE.Signal_Add (Signal_Mask, RTE.SIGTSTP);
RTE.Signal_Add (Signal_Mask, RTE.SIGTTIN);
RTE.Signal_Add (Signal_Mask, RTE.SIGTTOU);
-- Not POSIX required signals
RTE.Signal_Add (Signal_Mask, RTE.SIGSYS);
RTE.Signal_Add (Signal_Mask, RTE.SIGURG);
RTE.Signal_Add (Signal_Mask, RTE.SIGIO);
RTE.Signal_Add (Signal_Mask, RTE.SIGXCPU);
RTE.Signal_Add (Signal_Mask, RTE.SIGXFSZ);
RTE.Signal_Add (Signal_Mask, RTE.SIGVTALRM);
RTE.Signal_Add (Signal_Mask, RTE.SIGPROF);
RTE.Signal_Add (Signal_Mask, RTE.SIGWINCH);
RTE.Signal_Add (Signal_Mask, RTE.SIGLOST);
RTE.sigprocmask (RTE.SIG_UNBLOCK, Signal_Mask, Old_Set, Result);
Assert (Result /= Failure, "GNULL failure---sigprocmask");
end Unmask_All_Signals;
----------------------------
-- Is_Blocked_Unprotected --
----------------------------
function Is_Blocked_Unprotected
(S : Interfaces.C.POSIX_RTE.Signal) return boolean is
begin
return Signal_Server_Table (S).Blocked;
end Is_Blocked_Unprotected;
----------------------------
-- Is_Ignored_Unprotected --
----------------------------
function Is_Ignored_Unprotected
(S : Interfaces.C.POSIX_RTE.Signal) return boolean is
begin
return Signal_Server_Table (S).Ignored;
end Is_Ignored_Unprotected;
end System.Signals;